home *** CD-ROM | disk | FTP | other *** search
/ An Introduction to Progr…l Basic 6.0 (4th Edition) / An Introduction to Programming using Visual Basic 6.0.iso / PROGRAMS / CH6 / 6-4.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-11-02  |  8.5 KB  |  247 lines
  1. VERSION 5.00
  2. Begin VB.Form frmLoan 
  3.    Caption         =   "Analysis Of A Loan"
  4.    ClientHeight    =   4005
  5.    ClientLeft      =   510
  6.    ClientTop       =   1845
  7.    ClientWidth     =   9000
  8.    BeginProperty Font 
  9.       Name            =   "MS Sans Serif"
  10.       Size            =   8.25
  11.       Charset         =   0
  12.       Weight          =   700
  13.       Underline       =   0   'False
  14.       Italic          =   0   'False
  15.       Strikethrough   =   0   'False
  16.    EndProperty
  17.    LinkTopic       =   "Form1"
  18.    PaletteMode     =   1  'UseZOrder
  19.    ScaleHeight     =   4005
  20.    ScaleWidth      =   9000
  21.    Begin VB.CommandButton cmdQuit 
  22.       Caption         =   "Quit"
  23.       Height          =   375
  24.       Left            =   960
  25.       TabIndex        =   9
  26.       Top             =   3360
  27.       Width           =   1575
  28.    End
  29.    Begin VB.CommandButton cmdAmort 
  30.       Caption         =   "Display Amortization Schedule"
  31.       Height          =   375
  32.       Left            =   120
  33.       TabIndex        =   8
  34.       Top             =   2760
  35.       Width           =   3255
  36.    End
  37.    Begin VB.CommandButton cmdRateTable 
  38.       Caption         =   "Display Interest Rate Change Table"
  39.       Height          =   375
  40.       Left            =   120
  41.       TabIndex        =   7
  42.       Top             =   2160
  43.       Width           =   3255
  44.    End
  45.    Begin VB.CommandButton cmdPayment 
  46.       Caption         =   "Calculate Monthly Payment"
  47.       Height          =   375
  48.       Left            =   120
  49.       TabIndex        =   6
  50.       Top             =   1560
  51.       Width           =   3255
  52.    End
  53.    Begin VB.PictureBox picDisp 
  54.       Height          =   3735
  55.       Left            =   3600
  56.       ScaleHeight     =   3675
  57.       ScaleWidth      =   5235
  58.       TabIndex        =   10
  59.       Top             =   120
  60.       Width           =   5292
  61.    End
  62.    Begin VB.TextBox txtYrs 
  63.       Height          =   285
  64.       Left            =   2160
  65.       TabIndex        =   5
  66.       Top             =   1080
  67.       Width           =   1215
  68.    End
  69.    Begin VB.TextBox txtApr 
  70.       Height          =   285
  71.       Left            =   2160
  72.       TabIndex        =   3
  73.       Top             =   600
  74.       Width           =   1215
  75.    End
  76.    Begin VB.TextBox txtAmt 
  77.       Height          =   285
  78.       Left            =   2160
  79.       TabIndex        =   1
  80.       Top             =   120
  81.       Width           =   1215
  82.    End
  83.    Begin VB.Label lblYrs 
  84.       Alignment       =   1  'Right Justify
  85.       Caption         =   "Number Of Loan Years:"
  86.       Height          =   255
  87.       Left            =   0
  88.       TabIndex        =   4
  89.       Top             =   1080
  90.       Width           =   2055
  91.    End
  92.    Begin VB.Label lblApr 
  93.       Alignment       =   1  'Right Justify
  94.       Caption         =   "Interest APR:"
  95.       Height          =   255
  96.       Left            =   0
  97.       TabIndex        =   2
  98.       Top             =   600
  99.       Width           =   2055
  100.    End
  101.    Begin VB.Label lblAmt 
  102.       Alignment       =   1  'Right Justify
  103.       Caption         =   "Amount Of Loan:"
  104.       Height          =   255
  105.       Left            =   0
  106.       TabIndex        =   0
  107.       Top             =   120
  108.       Width           =   2055
  109.    End
  110. Attribute VB_Name = "frmLoan"
  111. Attribute VB_GlobalNameSpace = False
  112. Attribute VB_Creatable = False
  113. Attribute VB_PredeclaredId = True
  114. Attribute VB_Exposed = False
  115. Private Function Balance(mPayment As Single, prin As Single, mRate As Single) As Single
  116.   Dim newBal As Single
  117.   'Compute balance at end of month
  118.   newBal = (1 + mRate) * prin
  119.   If newBal <= mPayment Then
  120.       mPayment = newBal
  121.       Balance = 0
  122.     Else
  123.       Balance = newBal - mPayment
  124.   End If
  125. End Function
  126. Private Sub cmdAmort_Click()
  127.   Dim principal As Single   'Amount of loan
  128.   Dim yearlyRate As Single  'Annual rate of interest
  129.   Dim numMonths As Integer  'Number of months to repay loan
  130.   Call InputData(principal, yearlyRate, numMonths)
  131.   Call ShowAmortSched(principal, yearlyRate, numMonths)
  132. End Sub
  133. Private Sub cmdPayment_Click()
  134.   Dim principal As Single   'Amount of loan
  135.   Dim yearlyRate As Single  'Annual rate of interest
  136.   Dim numMonths As Integer  'Number of months to repay loan
  137.   Call InputData(principal, yearlyRate, numMonths)
  138.   Call ShowPayment(principal, yearlyRate, numMonths)
  139. End Sub
  140. Private Sub cmdQuit_Click()
  141.   End
  142. End Sub
  143. Private Sub cmdRateTable_Click()
  144.   Dim principal As Single   'Amount of loan
  145.   Dim yearlyRate As Single  'Annual rate of interest
  146.   Dim numMonths As Integer  'Number of months to repay loan
  147.   Call InputData(principal, yearlyRate, numMonths)
  148.   Call ShowInterestChanges(principal, yearlyRate, numMonths)
  149. End Sub
  150. Private Sub InputData(prin As Single, yearlyRate As Single, numMs As Integer)
  151.   Dim percentageRate As Single, numYears As Integer
  152.   'Input the loan amount, yearly rate of interest, and duration
  153.   prin = Val(txtAmt.Text)
  154.   percentageRate = Val(txtApr.Text)
  155.   numYears = Val(txtYrs.Text)
  156.   yearlyRate = percentageRate / 100
  157.   numMs = numYears * 12
  158. End Sub
  159. Private Function Payment(prin As Single, mRate As Single, numMs As Integer) As Single
  160.   Dim payEst As Single
  161.   If numMs = 0 Then
  162.       payEst = prin
  163.     ElseIf mRate = 0 Then
  164.       payEst = prin / numMs
  165.     Else
  166.       payEst = prin * mRate / (1 - (1 + mRate) ^ (-numMs))
  167.   End If
  168.   If payEst <> Round(payEst, 2) Then
  169.     Payment = Round(payEst + 0.005, 2)  'round up to nearest cent
  170.   End If
  171. End Function
  172. Private Sub ShowAmortSched(prin As Single, yearlyRate As Single, numMs As Integer)
  173.   Dim msg As String, startMonth As Integer, mRate As Single
  174.   Dim monthlyPayment As Single, totalInterest As Single
  175.   Dim yearInterest As Single, oldBalance As Single
  176.   Dim monthNum As Integer, newBalance As Single
  177.   Dim principalPaid As Single, interestPaid As Single
  178.   Dim reducPrin As Single, loanYears As Integer
  179.   'Display amortization schedule
  180.   msg = "Please enter year (1-" & Str(numMs / 12)
  181.   msg = msg & ") for which amorization is to be shown:"
  182.   startMonth = 12 * Val(InputBox(msg)) - 11
  183.   picDisp.Cls
  184.   picDisp.Print "", "Amount Paid ",
  185.   picDisp.Print "Amount Paid", "Balance at"
  186.   picDisp.Print "Month", "for Principal",
  187.   picDisp.Print "for Interest", "End of Month"
  188.   mRate = yearlyRate / 12     'monthly rate
  189.   monthlyPayment = Payment(prin, mRate, numMs)
  190.   totalInterest = 0
  191.   yearInterest = 0
  192.   oldBalance = prin
  193.   For monthNum = 1 To numMs
  194.     newBalance = Balance(monthlyPayment, oldBalance, mRate)
  195.     principalPaid = oldBalance - newBalance
  196.     interestPaid = monthlyPayment - principalPaid
  197.     totalInterest = totalInterest + interestPaid
  198.     If (monthNum >= startMonth) And (monthNum <= startMonth + 11) Then
  199.         picDisp.Print Tab(2); FormatNumber(monthNum, 0),
  200.         picDisp.Print FormatCurrency(principalPaid),
  201.         picDisp.Print FormatCurrency(interestPaid),
  202.         picDisp.Print FormatCurrency(newBalance)
  203.         yearInterest = yearInterest + interestPaid
  204.     End If
  205.     oldBalance = newBalance
  206.   Next monthNum
  207.   reducPrin = 12 * monthlyPayment - yearInterest
  208.   loanYears = numMs / 12
  209.   picDisp.Print
  210.   picDisp.Print "Reduction in principal",
  211.   picDisp.Print FormatCurrency(reducPrin)
  212.   picDisp.Print "Interest paid", ,
  213.   picDisp.Print FormatCurrency(yearInterest)
  214.   picDisp.Print "Total interest over"; loanYears; "years",
  215.   picDisp.Print FormatCurrency(totalInterest)
  216. End Sub
  217. Private Sub ShowInterestChanges(prin As Single, yearlyRate As Single, numMs As Integer)
  218.   Dim newRate As Single, mRate As Single, py As Single
  219.   Dim pymnt As String
  220.   'Display affect of interest changes
  221.   picDisp.Cls
  222.   picDisp.Print , "Annual"
  223.   picDisp.Print , "Interest rate", "Monthly Payment"
  224.   newRate = yearlyRate - 0.01
  225.     mRate = newRate / 12    'monthly rate
  226.     py = Payment(prin, mRate, numMs)
  227.     pymnt = FormatCurrency(py)
  228.     picDisp.Print , FormatPercent(newRate, 3), pymnt
  229.     newRate = newRate + 0.00125
  230.   Loop Until newRate > yearlyRate + 0.01
  231. End Sub
  232. Private Sub ShowPayment(prin As Single, yearlyRate As Single, numMs As Integer)
  233.   Dim mRate As Single, prn As String, apr As String
  234.   Dim yrs As String, pay As Single, pymnt As String
  235.   'Display monthly payment amount
  236.   mRate = yearlyRate / 12  'monthly rate
  237.   prn = FormatCurrency(prin)
  238.   apr = FormatNumber(yearlyRate * 100)
  239.   yrs = FormatNumber(numMs / 12, 0)
  240.   pay = Payment(prin, mRate, numMs)
  241.   pymnt = FormatCurrency(pay)
  242.   picDisp.Cls
  243.   picDisp.Print "The monthly payment for a " & prn & " loan at "
  244.   picDisp.Print apr & "% annual rate of interest for ";
  245.   picDisp.Print yrs & " years is " & pymnt
  246. End Sub
  247.